home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / demostu2 / doom1.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-11-26  |  11.5 KB  |  482 lines
  1. PROGRAM doom1;
  2. {
  3.   DOOM engine, version 0.00001
  4.   - by Bjarke Viksφe
  5.   nov 1994
  6.  
  7.   Actually, this is pretty much based on the idea from the CYBERSPACE
  8.   sources by Phantom/Nostalgia.
  9.   This one was build by expanding my floor routines...
  10.   and I will add some textured walls later ;)
  11. }
  12.  
  13. {$A+,B-,G+,E+,I+,N-,X+}
  14. {$C FIXED PRELOAD PERMANENT}
  15.  
  16. USES
  17.     DEMOINIT,MOUSE,ILBM256,PICTURE;
  18.  
  19. {{$DEFINE DEBUG}
  20.  
  21. TYPE
  22.     pBunk = ^BunkArray;
  23.     BunkArray = ARRAY[0..254, 0..255] of byte;
  24.     pIntegerArray = ^IntegerArray;
  25.     IntegerArray = ARRAY[0..32760] of integer;
  26.  
  27. CONST
  28.     LINES = 70; {how many lines shall we paint}
  29.     TILT = 31780; {tilt floor how much?}
  30.  
  31. VAR
  32.     map, tiles : pBunk;
  33.     LineTable : array[1..3] of pIntegerArray;
  34.     xpos,ypos, angle : word;
  35.     CoordPtr : array[0..255] of pointer;
  36.     SinusTable  : array[0..639] of integer;
  37.  
  38.     {DOOM draw private variables}
  39. VAR
  40.     tablepos : word;
  41.     height : word;
  42. CONST
  43.     {table that describes how the colours fades away...}
  44.     colourtable : array[1..LINES] of byte =
  45.     (224,224,224,224,
  46.     192,192,192,192,192,192,
  47.     160,160,160,160,160,160,160,
  48.     128,128,128,128,128,128,128,128,
  49.     96,96,96,96,96,96,96,96,
  50.     64,64,64,64,64,64,64,64,64,
  51.     32,32,32,32,32,32,32,32,32,32,
  52.     0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
  53.  
  54.  
  55.  
  56. (*------------------------------------------------*)
  57.  
  58. procedure SetupSinus;
  59. var
  60.     i : integer;
  61.     v, vadd : real;
  62. begin
  63.     v:=0.0;
  64.     vadd:=(2.0*pi/512.0);
  65.     for i:=0 to 639 do begin
  66.         SinusTable[i]:=round(sin(v)*32767);
  67.         v:=v+vadd;
  68.     end;
  69. end;
  70.  
  71. procedure SetColours;
  72. {Setup ugly colours}
  73. var
  74.     i,j,k,fac : integer;
  75. begin
  76.     {calc 8 shades of our 32 colours}
  77.     k:=1;
  78.     fac:=256;
  79.     for i:=1 to 8 do begin
  80.         for j:=1 to (32*3) do begin
  81.             CMAP[k]:=(CMAP[j] * fac) DIV 256;
  82.             inc(k);
  83.         end;
  84.         dec(fac,31);
  85.     end;
  86.     SetCMAP;
  87. end;
  88.  
  89.  
  90. procedure CreateMap;
  91. var
  92.     charmap : array[#0..#128] of byte;
  93. {Create map.
  94.  Characters in string are indexes to tiles! 'a' is tile #0,
  95.  'b' is #1 (red one) and so...}
  96.  procedure Strip(ypos : integer; st : string);
  97.  var j : integer;
  98.  begin
  99.         for j:=1 to length(st) do st[j]:=char(charmap[st[j]]);
  100.         Move(st[1],map^[ypos,1],length(st));
  101.  end;
  102. var
  103.     c : char;
  104. begin
  105.     GetMem(map,65535);
  106.     FillChar(map^,65535,#0);
  107.  
  108.     charmap[' ']:=0;
  109.     for c:='a' to 'z' do charmap[c]:=ord(c)-ord('a');
  110.     for c:='A' to 'Z' do charmap[c]:=ord(c)-ord('A');
  111.  
  112.     {ceiling}
  113.     Strip(148,'     bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb                            ');
  114.     Strip(149,'     bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb                            ');
  115.     Strip(150,'     bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb                            ');
  116.     Strip(151,'     bbb                                                         ');
  117.     Strip(152,'     bbb                                                         ');
  118.     Strip(153,'     bbb                                                         ');
  119.     Strip(154,'     bbb                                                         ');
  120.     Strip(155,'     bbb                                                         ');
  121.     Strip(156,'     bbb                                                         ');
  122.     Strip(157,'     bbb                                                         ');
  123.     Strip(158,'     bbb                                                         ');
  124.     Strip(159,'     bbb                                                         ');
  125.     Strip(160,'     bbb                                                         ');
  126.     Strip(161,'     bbbeeeee                                                    ');
  127.     Strip(162,'     bbbeeeee                                                    ');
  128.     Strip(163,'     bbbeeeee                                                    ');
  129.     {floor}
  130.     Strip( 20,'     cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdc                         ');
  131.     Strip( 21,'     dcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcd                         ');
  132.     Strip( 22,'     cdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdcdc                         ');
  133.     Strip( 23,'     dcd                             ggg                         ');
  134.     Strip( 24,'     cdc                             ggg                         ');
  135.     Strip( 25,'     dcd                             ggg                         ');
  136.     Strip( 26,'     cdc                                                         ');
  137.     Strip( 27,'     dcd                                                         ');
  138.     Strip( 28,'     cdc                                                         ');
  139.     Strip( 29,'     dcd                                                         ');
  140.     Strip( 30,'     cdc                                                         ');
  141.     Strip( 31,'     dcd                                                         ');
  142.     Strip( 32,'     cdc                                                         ');
  143.     Strip( 33,'     dcdffff                                                     ');
  144.     Strip( 34,'     cdcffff                                                     ');
  145.     Strip( 35,'     dcdffff                                                     ');
  146. end;
  147.  
  148. procedure CreateTiles;
  149. {Build the tiles. Load .lbm graphics picture}
  150. var
  151.     i,j,k : word;
  152. begin
  153.     GetMem(tiles,65535);
  154.     FillChar(tiles^,65535,#0);
  155.  
  156.     LoadPix(pScreen(tiles),'doomgfx1.lbm');
  157.     {picture is 320x200. Need to convert it to 256x128}
  158.     j:=0; k:=0;
  159.     for i:=1 to 200 do begin
  160.         Move(pscreen(tiles)^[j],pScreen(tiles)^[k],256);
  161.         inc(j,320);
  162.         inc(k,256);
  163.     end;
  164. end;
  165.  
  166.  
  167. procedure PrecalcLines;
  168. {Precalc rotated floor-lines data}
  169. const
  170.     XPOS = 15; {this will ajust the height of the viewer}
  171. var
  172.     q,p,i, x1,y1,x2,y2 : integer;
  173.     z,sin1,cos1 : integer;
  174.     pos,angle : word;
  175.     cx,cy : longint;
  176. begin
  177.     for i:=1 to 3 do GetMem(LineTable[i],65535);
  178.  
  179.     p:=1;
  180.     pos:=0;
  181.     angle:=0;
  182.     for q:=0 to 255 do begin
  183.         CoordPtr[q]:=@LineTable[p]^[pos];
  184.  
  185.         z:=31100;
  186.         sin1:=SinusTable[angle];
  187.         cos1:=SinusTable[angle+128];
  188.         for i:=1 to LINES do begin
  189.             x1:=LongDiv(-XPOS*65536,z); {calc first coord}
  190.             y1:=LongDiv((i)*longint(TILT),z);
  191.             cx := (LongMul(x1,cos1) - LongMul(y1,sin1)) DIV 32768; {rotate it}
  192.             cy := (LongMul(x1,sin1) + LongMul(y1,cos1)) DIV 32768;
  193.             x1:=cx;
  194.             y1:=cy;
  195.             LineTable[p]^[pos]:=x1;
  196.             LineTable[p]^[pos+1]:=y1;
  197.  
  198.             x2:=LongDiv(XPOS*65535,z); {calc second coord}
  199.             y2:=LongDiv((i)*longint(TILT),z);
  200.             cx := (LongMul(x2,cos1) - LongMul(y2,sin1)) DIV 32768; {rotate it}
  201.             cy := (LongMul(x2,sin1) + LongMul(y2,cos1)) DIV 32768;
  202.             x2:=cx;
  203.             y2:=cy;
  204.             LineTable[p]^[pos+2]:=(longint(x2-x1) SHL 11) DIV 160;
  205.             LineTable[p]^[pos+3]:=(longint(y2-y1) SHL 11) DIV 160;
  206.             inc(pos,4);
  207.  
  208.             dec(z,330);
  209.         end;
  210.  
  211.         {Check if next set of coords should be placed in other buffer, since
  212.          they cannot all fit into one 64Kb segment!!!}
  213.         if ((pos*2 + (LINES*8)) > 65200) then begin
  214.             inc(p);
  215.             pos:=0;
  216.         end;
  217.         inc(angle,1); {calc next angle}
  218.     end;
  219. end;
  220.  
  221.  
  222.  
  223. procedure InitDemo;
  224. var
  225.     i : integer;
  226. begin
  227.     ClearWholeScreen;
  228.     SetupSinus;
  229.  
  230.     CreateMap;
  231.     CreateTiles;
  232.     SetColours;
  233.     PrecalcLines;
  234.  
  235.     xpos:=200; ypos:=400;
  236.     angle:=0;
  237. end;
  238.  
  239. procedure UninitDemo;
  240. var
  241.     i : integer;
  242. begin
  243.     FreeMem(map,65535);
  244.     FreeMem(tiles,65535);
  245.     for i:=1 to 3 do FreeMem(LineTable[i],65535);
  246. end;
  247.  
  248.  
  249. (*------------------------------------------------*)
  250.  
  251. procedure MoveHero;
  252. var
  253.     x,y, sin1,cos1 : integer;
  254.     cx,cy : longint;
  255. begin
  256.     {Determine new rotation angle}
  257.     ReadMouseMotionCounters(x,y);
  258.     angle:=(angle + x) AND 511;
  259.  
  260.     {is hero moving forward?}
  261.     if (LeftButton) then begin
  262.         sin1:=SinusTable[angle];
  263.         cos1:=SinusTable[angle+128];
  264.         x:=0;  {this is the moving speed}
  265.         y:=(5*(retraces+1)) DIV 2;
  266.         cx := (longmul(x,cos1) - longmul(y,sin1)) DIV 32768;
  267.         cy := (longmul(x,sin1) + longmul(y,cos1)) DIV 32768;
  268.         inc(xpos,cx);
  269.         inc(ypos,cy);
  270.     end;
  271.  
  272.     {hero cannot move outside board}
  273.     if (xpos<200) then xpos:=200;
  274.     if (xpos>16384) then xpos:=16384;
  275.     if (ypos<200) then ypos:=200;
  276.     if (ypos>16384) then ypos:=16384;
  277. end;
  278.  
  279. (*------------------------------------------------*)
  280.  
  281. procedure DrawDoom(x,y, angle : integer; Coords : pointer); assembler;
  282. var
  283.     xadd,yadd,
  284.     mappos : word;
  285.     mapxadd,mapyadd : integer;
  286.     counts : word;
  287.     ceilingtile, flooradd : word;
  288.     colouradd : byte;
  289.     filled : array[0..159] of boolean;
  290. asm
  291.     push    ds
  292.  
  293.     mov    es,SEGA000
  294.     mov    di,10*320
  295.  
  296.     mov    [flooradd],(160*320)-2
  297.     mov    [colouradd],0
  298.  
  299.  
  300.     mov    ax,WORD PTR [map+2]
  301.     {mov fs,ax} DB $8E,$E0
  302.     mov    ax,WORD PTR [Coords+2]
  303.     {mov gs,ax} DB $8E,$E8
  304.     mov    ax,WORD PTR [Coords]
  305.     mov    [tablepos],ax
  306.  
  307.     cld
  308.     mov    [height],LINES
  309. @y_run:
  310.  
  311.     mov    si,[tablepos]
  312.  
  313.     DB GS; mov    ax,[si+4]
  314.     cmp    [angle],256
  315.     jb        @anglelow1
  316.     neg    ax
  317. @anglelow1:
  318.     mov    [xadd],ax
  319.     mov    [mapxadd],1
  320.     or        ax,ax
  321.     jns    @mapxup
  322.     mov    [mapxadd],-1
  323. @mapxup:
  324.  
  325.     DB GS; mov    ax,[si+6]
  326.     cmp    [angle],256
  327.     jb        @anglelow2
  328.     neg    ax
  329. @anglelow2:
  330.     mov    [yadd],ax
  331.     mov    [mapyadd],256
  332.     or        ax,ax
  333.     jns    @mapyup
  334.     mov    [mapyadd],-256
  335. @mapyup:
  336.  
  337.     DB GS; mov    dx,[si]
  338.     DB GS; mov    cx,[si+2]
  339.     cmp    [angle],256
  340.     jb        @anglelow3
  341.     neg    cx
  342.     neg    dx
  343. @anglelow3:
  344.     add    dx,[x]
  345.     add    cx,[y]
  346.  
  347.     mov    bx,dx                    {Find first tile}
  348.     mov    ax,cx
  349.     shr    ax,5
  350.     shr    bx,5
  351.     mov    bh,al
  352.     mov    [mappos],bx
  353.     DB FS; mov al,[bx+$8000]    {get ceiling tile-index from map}
  354.     mov    ah,al                        {find map position in map-buffer}
  355.     and    al,7
  356.     shr    ah,3
  357.     shl    ax,5
  358.     mov    [ceilingtile],ax
  359.     DB FS; mov al,[bx]        {get floor tile-index from map}
  360.     mov    ah,al                    {find map position in map-buffer}
  361.     and    al,7
  362.     shr    ah,3
  363.     shl    ax,5
  364.     mov    si,ax
  365.     sub    [ceilingtile],ax
  366.  
  367.     shl    dx,11
  368.     shl    cx,11
  369.     xor    dx,$8000
  370.     xor    cx,$8000
  371.  
  372.     mov    ds,WORD PTR [tiles+2]
  373.     mov    [counts],160
  374. @x_run:
  375.     mov    bh,dh                    {get x-position of pixel}
  376.     mov    bl,ch                    {get y-position of pixel}
  377.     shr    bx,3
  378.     and    bx,$1F1F
  379.  
  380.     mov    al,[si+bx]            {get that pixel}
  381.     add    al,[colouradd]
  382.     mov    ah,al
  383.     stosw                            {store ceiling pixels}
  384.     add    bx,[ceilingtile]
  385.     mov    al,[si+bx]            {get that pixel}
  386.     add    al,[colouradd]
  387.     mov    ah,al
  388.     mov    bx,[flooradd]
  389.     mov    [es:di+bx],ax        {store floor pixels}
  390.  
  391.     add    dx,[xadd]            {add to x-slope}
  392.     jo        @doxadd
  393. @1:add    cx,[yadd]            {add to y-slope}
  394.     jo        @doyadd
  395. @2:dec    [counts]
  396.     jnz    @x_run
  397.     jmp    @nextline
  398.  
  399.  
  400. @doxadd:
  401.     mov    bx,[mappos]
  402.     add    bx,[mapxadd]
  403.     mov    [mappos],bx
  404.     DB FS; mov al,[bx+$8000]    {get new ceiling tile-index from map}
  405.     mov    ah,al                        {find tile position in tile-buffer}
  406.     and    al,7
  407.     shr    ah,3
  408.     shl    ax,5
  409.     mov    [ceilingtile],ax
  410.     DB FS; mov al,[bx]        {get new floor tile-index from map}
  411.     mov    ah,al                    {find tile position in tile-buffer}
  412.     and    al,7
  413.     shr    ah,3
  414.     shl    ax,5
  415.     mov    si,ax
  416.     sub    [ceilingtile],ax
  417.     jmp    NEAR PTR @1
  418.  
  419. @doyadd:
  420.     mov    bx,[mappos]
  421.     add    bx,[mapyadd]
  422.     mov    [mappos],bx
  423.     DB FS; mov al,[bx+$8000]    {get new ceiling tile-index from map}
  424.     mov    ah,al                        {find tile position in tile-buffer}
  425.     and    al,7
  426.     shr    ah,3
  427.     shl    ax,5
  428.     mov    [ceilingtile],ax
  429.     DB FS; mov al,[bx]        {get new floor tile-index from map}
  430.     mov    ah,al                    {find tile position in tile-buffer}
  431.     and    al,7
  432.     shr    ah,3
  433.     shl    ax,5
  434.     mov    si,ax
  435.     sub    [ceilingtile],ax
  436.     jmp    NEAR PTR @2
  437.  
  438.  
  439. @nextline:
  440.     mov    ax,SEG @DATA
  441.     mov    ds,ax
  442.  
  443.     sub    [flooradd],320*2
  444.     add    [tablepos],8
  445.  
  446.     mov    bx,[height]
  447.     mov    al,[OFFSET colourtable+bx-1]
  448.     mov    [colouradd],al
  449.  
  450.     dec    [height]
  451.     jnz    @y_run
  452.  
  453.     pop    ds
  454. end;
  455.  
  456.  
  457. (*------------------------------------------------*)
  458.  
  459. procedure RunOnce;
  460. var
  461.     i : integer;
  462. begin
  463.     while retraces=0 do ;
  464.     retraces:=0;
  465. {$IFDEF DEBUG}    SetRGB(0,20,0,0); {$ENDIF}
  466.     DrawDoom(xpos,ypos, angle, CoordPtr[angle AND 255]);
  467.     MoveHero;
  468. {$IFDEF DEBUG}    SetRGB(0,0,0,0); {$ENDIF}
  469. end;
  470.  
  471. begin
  472.     if NOT MouseDriverPresent then begin writeln('No mouse...'); halt; end;
  473.  
  474.     SetScreenMode($13);
  475.     InitDemo;
  476.     SetAllInterrupts;
  477.     repeat RunOnce until Key='e';
  478.     RestoreAllInterrupts;
  479.     UninitDemo;
  480.     SetScreenMode(TEXTMODE);
  481. end.
  482.